vcolobasic = 'w+/rb,gr+/r'
SAVE SCREEN TO vscreen
SET COLO TO W+/R
@ 24,0 CLEAR
STORE 0 TO vadd
DO BOX2 WITH 22,20,"DO YOU WANT TO ? :","ADD PROCEDURE","CANCEL",'GR+','RB','GR+','R',VADD,.F.,.T.
IF LASTKEY()=27 .OR. VADD=2
   REST SCREEN FROM vscreen
   RETURN
ENDIF
REST SCREEN FROM vscreen
SET COLO TO W+/G
@ 12,5 CLEAR TO 18,50
@ 12,5 TO 18,50 DOUBLE
@ 12,17 SAY '[Input Main Area]'
@ 13,6 SAY 'Main Area Code : '+kode1
@ 14,6 say 'Main Area Name : '+main
SELE 3
USE &DR&F3 INDE &DR&F3
vfile='sub_are'+kode1+'.dbf'
SAVE SCREEN TO vscreen2
store ' ' to vsubcode
store space(16) to vsubname
DO WHILE .T.
   SELE 3
   USE &DR&F3 INDE &DR&F3
   SET COLO TO r+/G
   @ 15,6 clear to 17,49
   @ 15,6 SAY 'Sub Area Code  :'
   @ 16,6 say 'Sub Area Name  :'
   set colo to /w+
   @ 16,23 say space(16)
   @ 15,23 GET vsubcode PICT '!'
   READ
   LY1=SAVESCREEN(0,0,24,79)
*   vrec=recno()
   GO TOP
   LOCA FOR area_code+sub_areaco = kode1+vsubcode
   IF .NOT. EOF()
      SET COLO TO W+*/R
      @ 24,0 CLEA
      @ 24,26 SAY 'This Sub Code is already exist !'
      @ 23,0 SAY ''
      WAIT ''
      RESTSCREEN(0,0,24,79,LY1)
      LOOP
   ENDIF
*   GO vrec
   @ 16,23 GET vsubname PICT '@!'
   READ
   store 'Y' to vright,vmore
   do get_optn with 'SAVE (Y/N)','YN',vright
   IF vright # 'Y'
*      LOOP
       exit
   ELSE
      IF FIL_LOCK()
         APPE BLANK
         IF REC_LOCK()
            REPL sub_areaco WITH vsubcode,sub_area WITH vsubname,area_code with kode1
            use &dr&vfile
            IF FIL_LOCK()
               APPE BLANK
               IF REC_LOCK()
                  REPL sub_areaco WITH vsubcode,sub_area WITH vsubname,area_code with kode1
               ENDIF
            ENDIF
         ENDIF
         UNLOCK
*         CLOS DATA
      ENDIF
   ENDIF
   do get_optn with 'ADD MORE SUB AREA ? (Y/N)','YN',vmore
   IF vmore # 'Y'
      EXIT
   ELSE
      VSUB=VAL(VSUBCODE)
      VSUB=VSUB+1
      VSUBCODE=STR(VSUB,1)
      LOOP
   ENDIF
ENDDO
SET COLO TO &vcolobasic
REST SCREEN  FROM VSCREEN
*kode1=vcode
kode2=vsubcode
sub=vsubname
*MAIN=VNAME
RELE ALL LIKE V*
RETURN
